home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Count the 197045172001.psc / frmMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-05-17  |  17.4 KB  |  552 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "VB Line Counter - Beta v1.1"
  5.    ClientHeight    =   7485
  6.    ClientLeft      =   150
  7.    ClientTop       =   630
  8.    ClientWidth     =   6495
  9.    LinkTopic       =   "Form1"
  10.    LockControls    =   -1  'True
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   7485
  13.    ScaleWidth      =   6495
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.ListBox lstFiles 
  16.       Height          =   1425
  17.       Left            =   360
  18.       TabIndex        =   24
  19.       Top             =   2280
  20.       Width           =   5775
  21.    End
  22.    Begin VB.CommandButton cmdReset 
  23.       Caption         =   "&Reset Counts"
  24.       Height          =   495
  25.       Left            =   2640
  26.       TabIndex        =   4
  27.       Top             =   6720
  28.       Width           =   1215
  29.    End
  30.    Begin VB.CommandButton cmdExit 
  31.       Caption         =   "E&xit"
  32.       Height          =   495
  33.       Left            =   4080
  34.       TabIndex        =   5
  35.       Top             =   6720
  36.       Width           =   1215
  37.    End
  38.    Begin VB.CommandButton cmdOK 
  39.       Caption         =   "&Get Line Count"
  40.       Default         =   -1  'True
  41.       Height          =   495
  42.       Left            =   1200
  43.       TabIndex        =   3
  44.       Top             =   6720
  45.       Width           =   1215
  46.    End
  47.    Begin VB.Frame frameResults 
  48.       Caption         =   "Results:"
  49.       Height          =   2535
  50.       Left            =   720
  51.       TabIndex        =   7
  52.       Top             =   3840
  53.       Width           =   5055
  54.       Begin VB.Label lblClasses 
  55.          Alignment       =   2  'Center
  56.          Caption         =   "0"
  57.          Height          =   255
  58.          Left            =   2400
  59.          TabIndex        =   23
  60.          Top             =   840
  61.          Width           =   1995
  62.       End
  63.       Begin VB.Label lblModules 
  64.          Alignment       =   2  'Center
  65.          Caption         =   "0"
  66.          Height          =   255
  67.          Left            =   2400
  68.          TabIndex        =   22
  69.          Top             =   600
  70.          Width           =   1995
  71.       End
  72.       Begin VB.Label lblForms 
  73.          Alignment       =   2  'Center
  74.          Caption         =   "0"
  75.          Height          =   255
  76.          Left            =   2400
  77.          TabIndex        =   21
  78.          Top             =   360
  79.          Width           =   1995
  80.       End
  81.       Begin VB.Label Label9 
  82.          Caption         =   "Number of Forms:"
  83.          Height          =   255
  84.          Left            =   480
  85.          TabIndex        =   20
  86.          Top             =   360
  87.          Width           =   1455
  88.       End
  89.       Begin VB.Label Label8 
  90.          Caption         =   "Number of Modules:"
  91.          Height          =   255
  92.          Left            =   480
  93.          TabIndex        =   19
  94.          Top             =   600
  95.          Width           =   1455
  96.       End
  97.       Begin VB.Label Label7 
  98.          Caption         =   "Number of Classes:"
  99.          Height          =   255
  100.          Left            =   480
  101.          TabIndex        =   18
  102.          Top             =   840
  103.          Width           =   1455
  104.       End
  105.       Begin VB.Label lblTotal 
  106.          Alignment       =   2  'Center
  107.          Caption         =   "0"
  108.          Height          =   255
  109.          Left            =   2400
  110.          TabIndex        =   17
  111.          Top             =   2040
  112.          Width           =   1995
  113.       End
  114.       Begin VB.Label lblBlank 
  115.          Alignment       =   2  'Center
  116.          Caption         =   "0"
  117.          Height          =   255
  118.          Left            =   2400
  119.          TabIndex        =   16
  120.          Top             =   1680
  121.          Width           =   1995
  122.       End
  123.       Begin VB.Label lblComments 
  124.          Alignment       =   2  'Center
  125.          Caption         =   "0"
  126.          Height          =   255
  127.          Left            =   2400
  128.          TabIndex        =   15
  129.          Top             =   1440
  130.          Width           =   1995
  131.       End
  132.       Begin VB.Label lblCode 
  133.          Alignment       =   2  'Center
  134.          Caption         =   "0"
  135.          Height          =   255
  136.          Left            =   2400
  137.          TabIndex        =   14
  138.          Top             =   1200
  139.          Width           =   1995
  140.       End
  141.       Begin VB.Label Label6 
  142.          Caption         =   "Total Lines:"
  143.          BeginProperty Font 
  144.             Name            =   "MS Sans Serif"
  145.             Size            =   8.25
  146.             Charset         =   0
  147.             Weight          =   700
  148.             Underline       =   0   'False
  149.             Italic          =   0   'False
  150.             Strikethrough   =   0   'False
  151.          EndProperty
  152.          Height          =   255
  153.          Left            =   480
  154.          TabIndex        =   13
  155.          Top             =   2040
  156.          Width           =   1455
  157.       End
  158.       Begin VB.Label Label5 
  159.          Caption         =   "Blank Lines:"
  160.          Height          =   255
  161.          Left            =   480
  162.          TabIndex        =   12
  163.          Top             =   1680
  164.          Width           =   1455
  165.       End
  166.       Begin VB.Label Label4 
  167.          Caption         =   "Lines of Comments:"
  168.          Height          =   255
  169.          Left            =   480
  170.          TabIndex        =   11
  171.          Top             =   1440
  172.          Width           =   1455
  173.       End
  174.       Begin VB.Label Label3 
  175.          Caption         =   "Lines of Code:"
  176.          Height          =   255
  177.          Left            =   480
  178.          TabIndex        =   10
  179.          Top             =   1200
  180.          Width           =   1455
  181.       End
  182.    End
  183.    Begin VB.Frame Frame1 
  184.       Height          =   1935
  185.       Left            =   240
  186.       TabIndex        =   6
  187.       Top             =   120
  188.       Width           =   6015
  189.       Begin VB.CheckBox chkSub 
  190.          Caption         =   "Search SubDirectories"
  191.          Height          =   255
  192.          Left            =   240
  193.          TabIndex        =   25
  194.          Top             =   1560
  195.          Width           =   2175
  196.       End
  197.       Begin VB.CommandButton cmdBrowse 
  198.          Caption         =   "..."
  199.          Height          =   285
  200.          Left            =   5280
  201.          TabIndex        =   2
  202.          Top             =   1200
  203.          Width           =   495
  204.       End
  205.       Begin VB.TextBox txtFile 
  206.          Height          =   285
  207.          Left            =   240
  208.          TabIndex        =   1
  209.          Top             =   1200
  210.          Width           =   5055
  211.       End
  212.       Begin VB.ComboBox cmbMethod 
  213.          Height          =   315
  214.          Left            =   1440
  215.          Style           =   2  'Dropdown List
  216.          TabIndex        =   0
  217.          Top             =   480
  218.          Width           =   3015
  219.       End
  220.       Begin VB.Label Label1 
  221.          AutoSize        =   -1  'True
  222.          Caption         =   "File or Directory Location:"
  223.          Height          =   195
  224.          Left            =   240
  225.          TabIndex        =   9
  226.          Top             =   960
  227.          Width           =   1800
  228.       End
  229.       Begin VB.Label Label2 
  230.          Caption         =   "Select the type of file(s) you want to get a line count for:"
  231.          Height          =   255
  232.          Left            =   960
  233.          TabIndex        =   8
  234.          Top             =   240
  235.          Width           =   3975
  236.       End
  237.    End
  238.    Begin VB.Menu mnuFile 
  239.       Caption         =   "&File"
  240.       Begin VB.Menu mnuExit 
  241.          Caption         =   "&Exit"
  242.       End
  243.    End
  244.    Begin VB.Menu mnuhlp 
  245.       Caption         =   "&Help"
  246.       Begin VB.Menu mnuAbout 
  247.          Caption         =   "A&bout"
  248.       End
  249.    End
  250. Attribute VB_Name = "frmMain"
  251. Attribute VB_GlobalNameSpace = False
  252. Attribute VB_Creatable = False
  253. Attribute VB_PredeclaredId = True
  254. Attribute VB_Exposed = False
  255. Option Explicit
  256. Dim reg As New clsRegistry
  257. Private Sub cmbMethod_Click()
  258.   If cmbMethod.ListIndex = 0 Then
  259.     chkSub.Enabled = True
  260.   Else
  261.     chkSub.Enabled = False
  262.   End If
  263. End Sub
  264. Private Sub cmdBrowse_Click()
  265. Dim oas As New OpenSaveDialog
  266.   Select Case cmbMethod.ListIndex
  267.     Case 0
  268.       txtFile.Text = BrowseForFolder(Me.hwnd, "Select the foder you want to total all the lines in:")
  269.     Case 1
  270.       txtFile.Text = oas.OpenDialogBox(frmMain, fCustom, , , "VB Forms (*.frm)" + Chr$(0) + "*.frm" + Chr$(0) + "VB Modules (*.bas)" + Chr$(0) + "*.bas" + Chr$(0) + "VB Class Modules (*.cls)" + Chr$(0) + "*.cls" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0))
  271.     Case 2
  272.       txtFile.Text = oas.OpenDialogBox(frmMain, fCustom, , , "VB Projects (*.vbp)" + Chr$(0) + "*.vbp" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0))
  273.     Case 3
  274.       txtFile.Text = oas.OpenDialogBox(frmMain, fText)
  275.     Case Else
  276.       MsgBox "You must first select a method to browse by", vbCritical, "Duh"
  277.   End Select
  278. End Sub
  279. Private Sub cmdExit_Click()
  280.   Unload Me
  281. End Sub
  282. Private Sub cmdOK_Click()
  283. Dim fName As String, fPath As String
  284. Dim fFile As String, lCode As Long
  285. Dim lComments As Long, lBlank As Long
  286. Dim fNum As Integer, strData As String
  287. Dim pName As String, pMajor As String
  288. Dim pMinor As String, pRev As String
  289. Dim x As Integer
  290. Static FolderList As Collection
  291.   'Make sure that the top half is filled in
  292.   If cmbMethod.Text = "" Or txtFile.Text = "" Then
  293.     MsgBox "You must select a method to search by and a file to search!", vbCritical, "Dumb Ass"
  294.     Exit Sub
  295.   End If
  296.   Call ResetCounts(True)
  297.   cmdOK.Enabled = False
  298.   VB.Screen.MousePointer = 11
  299.   'Reset counters
  300.   cCode = 0
  301.   cComments = 0
  302.   cBlank = 0
  303.   cTotal = 0
  304.   cForms = 0
  305.   cModules = 0
  306.   cClasses = 0
  307.   frameResults.Caption = "Results:"
  308.   lstFiles.AddItem "All Files"
  309.   If cmbMethod.ListIndex = 0 Then 'Directory
  310.       
  311.     If Left(txtFile.Text, 1) <> "\" Then
  312.       fPath = txtFile.Text & "\"
  313.     Else
  314.       fPath = txtFile.Text
  315.     End If
  316.     If chkSub.Value = 1 Then
  317.       Call GetAllDirsFrom(fPath, "frm", lstFiles)
  318.       Call GetAllDirsFrom(fPath, "bas", lstFiles)
  319.       Call GetAllDirsFrom(fPath, "cls", lstFiles)
  320.     Else
  321.       fName = Dir(fPath & "*.frm")
  322.       Do Until fName = ""
  323.         fFile = fPath & fName
  324.         lstFiles.AddItem fFile
  325.         fName = Dir
  326.       Loop
  327.       
  328.       fName = Dir(fPath & "*.bas")
  329.       Do Until fName = ""
  330.         fFile = fPath & fName
  331.         lstFiles.AddItem fFile
  332.         fName = Dir
  333.       Loop
  334.       
  335.       fName = Dir(fPath & "*.cls")
  336.       Do Until fName = ""
  337.         fFile = fPath & fName
  338.         lstFiles.AddItem fFile
  339.         fName = Dir
  340.       Loop
  341.       
  342.     End If
  343.     If lstFiles.ListCount = 1 Then
  344.       MsgBox "There were no VB Forms, Modules or Class Modules found in this directory.  Please re-select and try again.", vbInformation, "No files found"
  345.       Call ResetCounts(True)
  346.       VB.Screen.MousePointer = 0
  347.       cmdOK.Enabled = True
  348.       Exit Sub
  349.     End If
  350.   ElseIf cmbMethod.ListIndex = 1 Then 'Single File
  351.     If Right(txtFile.Text, 3) = "frm" Then
  352.     ElseIf Right(txtFile.Text, 3) = "bas" Then
  353.     ElseIf Right(txtFile.Text, 3) = "cls" Then
  354.     Else
  355.       'Not a valid file
  356.       txtFile.Text = ""
  357.       lstFiles.Clear
  358.       MsgBox "The file you have selected is not a Visual Basic Form, Module, or Class Module.  Please re-select and try again.", vbCritical, "Bozo"
  359.       VB.Screen.MousePointer = 0
  360.       cmdOK.Enabled = True
  361.       Exit Sub
  362.     End If
  363.     'Add file to listbox
  364.     lstFiles.AddItem txtFile.Text
  365.       
  366.   ElseIf cmbMethod.ListIndex = 2 Then 'VB Project File
  367.     fName = txtFile.Text
  368.     If Right(fName, 3) <> "vbp" Then
  369.       'Not a valid file
  370.       txtFile.Text = ""
  371.       lstFiles.Clear
  372.       MsgBox "The file you have selected is not a Visual Basic Project file.  Please re-select and try again.", vbCritical, "Wake Up"
  373.       VB.Screen.MousePointer = 0
  374.       cmdOK.Enabled = True
  375.       Exit Sub
  376.     End If
  377.     x = InStrRev(fName, "\")
  378.     fPath = Left(fName, x)
  379.     fNum = FreeFile
  380.     Open fName For Input As fNum
  381.       Do Until EOF(fNum)
  382.         
  383.         Line Input #fNum, strData
  384.         
  385.         If Left(strData, 5) = "Name=" Then
  386.           pName = Mid(strData, 7)
  387.           pName = Left(pName, Len(pName) - 1)
  388.         ElseIf Left(strData, 9) = "MajorVer=" Then
  389.           pMajor = Mid(strData, 10)
  390.         ElseIf Left(strData, 9) = "MinorVer=" Then
  391.           pMinor = Mid(strData, 10)
  392.         ElseIf Left(strData, 12) = "RevisionVer=" Then
  393.           pRev = Mid(strData, 13)
  394.         ElseIf Left(strData, 5) = "Form=" Then
  395.         
  396.           fFile = GetFilePath(strData, fPath)
  397.           lstFiles.AddItem fFile
  398.             
  399.         ElseIf Left(strData, 7) = "Module=" Then
  400.         
  401.           fFile = GetFilePath(strData, fPath)
  402.           lstFiles.AddItem fFile
  403.           
  404.         ElseIf Left(strData, 6) = "Class=" Then
  405.         
  406.           fFile = GetFilePath(strData, fPath)
  407.           lstFiles.AddItem fFile
  408.           
  409.         End If
  410.         
  411.       Loop
  412.       
  413.     Close #fNum
  414.     frameResults.Caption = "Results: " & pName & " " & pMajor & "." & pMinor & "." & pRev
  415.   ElseIf cmbMethod.ListIndex = 3 Then 'Other
  416.     fNum = FreeFile
  417.     Open txtFile.Text For Input As fNum
  418.     Do Until EOF(fNum)
  419.       Line Input #fNum, strData
  420.       
  421.       Call StripBeginingSpaces(strData)
  422.       If strData = "" Then
  423.         cBlank = cBlank + 1
  424.       Else
  425.         cCode = cCode + 1
  426.       End If
  427.     Loop
  428.     Close #fNum
  429.     lstFiles.Clear
  430.     lblForms.Caption = cForms
  431.     lblModules.Caption = cModules
  432.     lblClasses.Caption = cClasses
  433.     lblCode.Caption = cCode
  434.     lblComments.Caption = cComments
  435.     lblBlank.Caption = cBlank
  436.     lblTotal.Caption = cCode + cComments + cBlank
  437.     GoTo Other
  438.   End If
  439.   lstFiles.Refresh
  440.   lstFiles.Selected(0) = True
  441.   Call AnalyzeFile(lstFiles.Text)
  442. Other:
  443.   VB.Screen.MousePointer = 0
  444.   cmdOK.Enabled = True
  445.   reg.SaveSettingString Local_Machine, "Software\Rossi\VBLineCounter", "Method", cmbMethod.Text
  446.   reg.SaveSettingString Local_Machine, "Software\Rossi\VBLineCounter", "File", txtFile.Text
  447.   reg.SaveSettingLong Local_Machine, "Software\Rossi\VBLineCounter", "CheckSubs", chkSub.Value
  448. End Sub
  449. Private Sub cmdReset_Click()
  450.   Call ResetCounts(True)
  451. End Sub
  452. Private Sub Form_Load()
  453.   With cmbMethod
  454.     .AddItem "Directory", 0
  455.     .AddItem "Single VB Item (Form, Class, Module)", 1
  456.     .AddItem "Visual Basic Project (.vbp)", 2
  457.     .AddItem "Other", 3
  458.   End With
  459.   cmbMethod.Text = reg.GetSettingString(Local_Machine, "Software\Rossi\VBLineCounter", "Method", "Visual Basic Project (.vbp)")
  460.   txtFile.Text = reg.GetSettingString(Local_Machine, "Software\Rossi\VBLineCounter", "File")
  461.   chkSub.Value = reg.GetSettingLong(Local_Machine, "Software\Rossi\VBLineCounter", "CheckSubs")
  462. End Sub
  463. Public Sub ResetCounts(Optional ClearListBox As Boolean = False)
  464.   If ClearListBox = True Then lstFiles.Clear
  465.   'Reset counters
  466.   cCode = 0
  467.   cComments = 0
  468.   cBlank = 0
  469.   cTotal = 0
  470.   cForms = 0
  471.   cModules = 0
  472.   cClasses = 0
  473.   'Reset labels
  474.   lblForms.Caption = 0
  475.   lblModules.Caption = 0
  476.   lblClasses.Caption = 0
  477.   lblCode.Caption = 0
  478.   lblComments.Caption = 0
  479.   lblBlank.Caption = 0
  480.   lblTotal.Caption = 0
  481.   frameResults.Caption = "Results:"
  482. End Sub
  483. Private Sub lstFiles_DblClick()
  484.   Call AnalyzeFile(lstFiles.Text)
  485. End Sub
  486. Public Function AnalyzeFile(FileName As String)
  487. Dim fFile As String, lCode As Long
  488. Dim lComments As Long, lBlank As Long
  489. Dim x As Integer, lCount As Integer
  490.   VB.Screen.MousePointer = 11
  491.   fFile = FileName
  492.   If fFile = "All Files" Then
  493.     Call ResetCounts
  494.     x = 1
  495.     For x = 1 To lstFiles.ListCount - 1
  496.       
  497.       fFile = lstFiles.List(x)
  498.       
  499.       Call GetLineCount(fFile, lCode, lComments, lBlank)
  500.       cCode = cCode + lCode
  501.       cComments = cComments + lComments
  502.       cBlank = cBlank + lBlank
  503.       
  504.       If Right(fFile, 3) = "frm" Then
  505.         cForms = cForms + 1
  506.       ElseIf Right(fFile, 3) = "bas" Then
  507.         cModules = cModules + 1
  508.       ElseIf Right(fFile, 3) = "cls" Then
  509.         cClasses = cClasses + 1
  510.       End If
  511.       
  512.       lblForms.Caption = cForms
  513.       lblModules.Caption = cModules
  514.       lblClasses.Caption = cClasses
  515.       lblCode.Caption = cCode
  516.       lblComments.Caption = cComments
  517.       lblBlank.Caption = cBlank
  518.       lblTotal.Caption = cCode + cComments + cBlank
  519.       DoEvents
  520.       
  521.     Next x
  522.   Else
  523.     Call ResetCounts
  524.     Call GetLineCount(fFile, lCode, lComments, lBlank)
  525.     cCode = cCode + lCode
  526.     cComments = cComments + lComments
  527.     cBlank = cBlank + lBlank
  528.     If Right(fFile, 3) = "frm" Then
  529.       cForms = cForms + 1
  530.     ElseIf Right(fFile, 3) = "bas" Then
  531.       cModules = cModules + 1
  532.     ElseIf Right(fFile, 3) = "cls" Then
  533.       cClasses = cClasses + 1
  534.     End If
  535.     lblForms.Caption = cForms
  536.     lblModules.Caption = cModules
  537.     lblClasses.Caption = cClasses
  538.     lblCode.Caption = cCode
  539.     lblComments.Caption = cComments
  540.     lblBlank.Caption = cBlank
  541.     lblTotal.Caption = cCode + cComments + cBlank
  542.     DoEvents
  543.   End If
  544.   VB.Screen.MousePointer = 0
  545. End Function
  546. Private Sub mnuAbout_Click()
  547.   frmAbout.Show
  548. End Sub
  549. Private Sub mnuExit_Click()
  550.   Unload Me
  551. End Sub
  552.